Copyright>        OpenRadioss
Copyright>        Copyright (C) 1986-2024 Altair Engineering Inc.
Copyright>
Copyright>        This program is free software: you can redistribute it and/or modify
Copyright>        it under the terms of the GNU Affero General Public License as published by
Copyright>        the Free Software Foundation, either version 3 of the License, or
Copyright>        (at your option) any later version.
Copyright>
Copyright>        This program is distributed in the hope that it will be useful,
Copyright>        but WITHOUT ANY WARRANTY; without even the implied warranty of
Copyright>        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Copyright>        GNU Affero General Public License for more details.
Copyright>
Copyright>        You should have received a copy of the GNU Affero General Public License
Copyright>        along with this program.  If not, see <https://www.gnu.org/licenses/>.
Copyright>
Copyright>
Copyright>        Commercial Alternative: Altair Radioss Software
Copyright>
Copyright>        As an alternative to this open-source version, Altair also offers Altair Radioss
Copyright>        software under a commercial license.  Contact Altair to discuss further if the
Copyright>        commercial version may interest you: https://www.altair.com/radioss/.
Chd|====================================================================
Chd|  R2R_SPLIT                     source/coupling/rad2rad/r2r_split.F
Chd|-- called by -----------
Chd|        LECTUR                        source/starter/lectur.F       
Chd|-- calls ---------------
Chd|        ANCMSG                        source/output/message/message.F
Chd|        CONSTIT                       source/elements/nodes/constit.F
Chd|        PRELECSEC                     source/tools/sect/prelecsec.F 
Chd|        R2R_MONVOL                    source/coupling/rad2rad/r2r_prelec.F
Chd|        TAGELEM_R2R                   source/coupling/rad2rad/tagelem_r2r.F
Chd|        NLOCAL                        source/spmd/node/ddtools.F    
Chd|        ALE_MOD                       ../common_source/modules/ale/ale_mod.F
Chd|        FRONT_MOD                     share/modules1/front_mod.F    
Chd|        GROUPDEF_MOD                  ../common_source/modules/groupdef_mod.F
Chd|        MESSAGE_MOD                   share/message_module/message_mod.F
Chd|        NOD2EL_MOD                    share/modules1/nod2el_mod.F   
Chd|        R2R_MOD                       share/modules1/r2r_mod.F      
Chd|        RESTMOD                       share/modules1/restart_mod.F  
Chd|        SUBMODEL_MOD                  share/modules1/submodel_mod.F 
Chd|====================================================================
      SUBROUTINE R2R_SPLIT(
     1           NB_LINE,
     2           NB_SURF,FLAG,EANI2,BUF_NOD,IXR_KJ,
     3           INOM_OPT,RESERVEP,NALE_R2R,NSPCOND0,
     4           SUBSET ,IGRSURF,IGRNOD  ,IGRBRIC,IGRQUAD,
     5           IGRSH4N,IGRSH3N,IGRTRUSS,IGRBEAM,IGRSPRING,
     6           IGRPART,IGRSLIN,LSUBMODEL,RBY_MSN,IWORKSH,
     7           SEATBELT_SHELL_TO_SPRING,NB_SEATBELT_SHELLS)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
        USE MY_ALLOC_MOD
        USE RESTMOD
        USE R2R_MOD
        USE NOD2EL_MOD
        USE FRONT_MOD
        USE MESSAGE_MOD
        USE GROUPDEF_MOD
        USE SUBMODEL_MOD
        USE ALE_MOD
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
#include      "com04_c.inc"
#include      "scr17_c.inc"
#include      "r2r_c.inc"
#include      "tabsiz_c.inc"
#include      "sphcom.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
        TYPE(SUBMODEL_DATA) LSUBMODEL(NSUBMOD)
        INTEGER BUF_NOD(*),
     .     NB_SURF,FLAG,
     .     EANI2(*),NB_LINE,
     .     IXR_KJ(*),INOM_OPT(*),RESERVEP(*),NALE_R2R(ALE%GLOBAL%SNALE),
     .     NSPCOND0,RBY_MSN(2,*)
        INTEGER, INTENT(INOUT) ::  IWORKSH(3,NUMELC+NUMELTG)
        INTEGER ,INTENT(IN) :: NB_SEATBELT_SHELLS
        INTEGER ,INTENT(IN) :: SEATBELT_SHELL_TO_SPRING(NUMELC,2)
        TYPE (SUBSET_) , DIMENSION(NSUBS)   :: SUBSET
        TYPE (SURF_)   , DIMENSION(NSURF)   :: IGRSURF
        TYPE (SURF_)   , DIMENSION(NSLIN)   :: IGRSLIN
        TYPE (GROUP_)  , DIMENSION(NGRNOD)  :: IGRNOD
        TYPE (GROUP_)  , DIMENSION(NGRBRIC) :: IGRBRIC
        TYPE (GROUP_)  , DIMENSION(NGRQUAD) :: IGRQUAD
        TYPE (GROUP_)  , DIMENSION(NGRSHEL) :: IGRSH4N
        TYPE (GROUP_)  , DIMENSION(NGRSH3N) :: IGRSH3N
        TYPE (GROUP_)  , DIMENSION(NGRTRUS) :: IGRTRUSS
        TYPE (GROUP_)  , DIMENSION(NGRBEAM) :: IGRBEAM
        TYPE (GROUP_)  , DIMENSION(NGRSPRI) :: IGRSPRING
        TYPE (GROUP_)  , DIMENSION(NGRPART) :: IGRPART
C-----------------------------------------------
C   E x t e r n a l   F u n c t i o n s
C-----------------------------------------------
        INTEGER  NLOCAL
        EXTERNAL NLOCAL
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
        INTEGER I,K,J,ADD,IAD,CUR_ID,TPP,CCPL,NF1,NF2,TYP2
        INTEGER COMPT,NSEG,FSKW,IDOM,NUMNOD_OLD
        INTEGER ISUR,ISURS,NTOT,NB_NOD_SUB,NB_NOD_CPL,NB_NOD
        INTEGER MAXN,MAXANUS,SIXSN,ID_INTER,NUL,TAG,COMPTB
        INTEGER COMPT10,COMPT20,COMPT16,COMPT8,J10,J20,J16,JJ
        INTEGER G1,G2,GRS,GRM,GRS2,LN1,LN2,NI,ID_MON,IAD3,IO_ERR
        INTEGER LNM,LNS,NEW_ID,SIPART0,SIPARTTH,COMPT_IP,COMPT_IP_TMP,L0
        INTEGER ID_PROP,COEFF,NUMSPHA,NSPHRESN,FIRST_CELL,NOD_ID,PART_RES,INOD
        INTEGER JJB,IUN,NRB,NRBODY_OLD
        CHARACTER TITR*40
        INTEGER, DIMENSION(:), POINTER :: PART1,PART2
        INTEGER, DIMENSION(:), ALLOCATABLE :: BUF_TEMP,ITAB_TEMP,IX_TEMP
        INTEGER, DIMENSION(:), ALLOCATABLE :: CORESN,CORESC,CORESTG,COREST
        INTEGER, DIMENSION(:), ALLOCATABLE :: CORESPA,CORESR,CORESP,CORESS,CORESSP
        INTEGER, DIMENSION(:), ALLOCATABLE :: IPART_TEMP,IWA_TEMP
        INTEGER, DIMENSION(:), ALLOCATABLE :: IPM_TEMP,IGEO_TEMP,CORESMA
        INTEGER, DIMENSION(:), ALLOCATABLE :: CORESPRO,TAGNO_TEMP
        INTEGER, DIMENSION(:), ALLOCATABLE :: IX10_TEMP,IX20_TEMP
        INTEGER, DIMENSION(:), ALLOCATABLE :: IX16_TEMP,CORESQ,ITAB_SUP
        INTEGER, DIMENSION(:), ALLOCATABLE :: KXSP_TEMP,RES_TEMP,NALE_R2R_TEMP
        INTEGER, DIMENSION(:,:), ALLOCATABLE :: RBY_MSN_TEMP,IWORKSH_TEMP
        my_real, DIMENSION(:,:), ALLOCATABLE :: X_TEMP
        my_real, DIMENSION(:), ALLOCATABLE :: THK_TMP,PM_TEMP
        my_real, DIMENSION(:), ALLOCATABLE :: EANI_TEMP,GEO_TEMP
        CHARACTER MESS*40
        CHARACTER OPT*ncharkey,KEY*ncharkey
        DATA MESS/'MULTIDOMAIN INITIALIZATION'/
        DATA IUN/1/
C===================================================================================

C----------------------------------------------------------------------------------C
C--------------------------------Initialisation------------------------------------C
C----------------------------------------------------------------------------------C

        N_PART = NPART

C----------------------------------------------------------------------------------C
C-----------------------First pass -> tag and count--------------------------------C
C----------------------------------------------------------------------------------C

        IF (FLAG==0) THEN

C----------------------------------------------------------------------------------C
C---------------------Allocation and initialisation of array tags------------------C
C----------------------------------------------------------------------------------C

          ALLOCATE(TAG_MAT(NUMMAT),TAG_PROP(NUMGEO),TAG_SUBS(NSUBS))
          ALLOCATE(TAG_SURF(NUMELC+NUMELTG+NUMELS+NPART))

          TAG_SURF(:) = 0
          TAG_SUBS(:) = 0
          TAG_PART(:) = 0

C------------Temporarily all mat and properties are kept --------------------------C
          TAG_MAT(:) = 1
          TAG_PROP(:) = 1

C------------TAG_EL must be stored-------------------------------------------------C
          ALLOCATE(TAG_ELCF2(NUMELC))
          ALLOCATE(TAG_ELSF2(NUMELS))
          TAG_ELCF2 = 0
          TAG_ELSF2 = 0
          DO I=1,NUMELS
            TAG_ELSF2(I) = TAG_ELS(I+NPART)
          END DO
          DO I=1,NUMELC
            TAG_ELCF2(I) = TAG_ELC(I+NPART)
          END DO

C----------------------------------------------------------------------------------C
C-----------------------------tag of data of the subdomain-------------------------C
C----------------------------------------------------------------------------------C

          IF (IDDOM/=0) THEN
            ADD = ISUBDOM(3,IDDOM)
            DO K=1,NPART
              DO I=1,ISUBDOM(1,IDDOM)
                IF(K == ISUBDOM_PART(I+ADD))THEN
                  TAG_PART(K)=1
                ENDIF
              ENDDO
            END DO
          ENDIF

C----------------Full domain --> tag of parts of all subdomains--------------------C

          IF (IDDOM == 0) THEN

            DO IDOM=1,NSUBDOM
              ADD = ISUBDOM(3,IDOM)
              DO K=1,NPART
                DO I=1,ISUBDOM(1,IDOM)
                  IF(K == ISUBDOM_PART(I+ADD))THEN
                    TAG_PART(K)=1
                  ENDIF
                ENDDO
              END DO
            END DO

C-        ----->Full domain --> inversion of tag of parts<---
            DO K=1,NPART
              IF(TAG_PART(K) == 1) THEN
                TAG_PART(K)=0
              ELSE
                TAG_PART(K)=1
              ENDIF
            END DO

          ENDIF

C---------------Tag of subsets-----------------------------------------------------C
!
C     --- TAG_SUBS  ---> ATTENTION not used
!
!        DO J=1,NSUBS
!    IAD3 = ISUBS(LISUB1*(J-1)+9)
!          DO K=1,ISUBS(LISUB1*(J-1)+8)
!      IF (TAG_PART(BUF_NOD(IAD3))>0) TAG_SUBS(J)=1
!      IAD3 = IAD3+1
!    END DO
!        END DO
!---
          DO J=1,NSUBS
            DO K=1,SUBSET(J)%NTPART
              IF (TAG_PART(SUBSET(J)%TPART(K))>0) TAG_SUBS(J)=1
!
            ENDDO
          ENDDO
!---

C---------------Tag of parts for tag of elements-----------------------------------C
          DO K=1,NPART
            IF(TAG_PART(K) == 1) THEN
              TAG_ELS(K)=1
              TAG_ELQ(K)=1
              TAG_ELC(K)=1
              TAG_ELT(K)=1
              TAG_ELP(K)=1
              TAG_ELR(K)=1
              TAG_ELG(K)=1
              TAG_ELSP(K)=1
              TAG_SURF(K)=1
C---------------Tag of materials and properties------------------------------------C
              TAG_MAT(IPART(LIPART1*(K-1)+1))=1
              TAG_PROP(IPART(LIPART1*(K-1)+2))=1
            ENDIF
          END DO

C---------------Nodes are already taged in TAGNO-----------------------------------C

C---------------Tag of elements----------------------------------------------------C

          SIPART0 = LIPART1*NPART+LIPART1*NTHPART
          SIPARTTH= 2*9*NPART+2*9*NTHPART
          L0 =SIPARTTH+SIPART0+1

          IF (NUMELS>0) CALL TAGELEM_R2R(NUMELS,IPART(L0),TAG_ELS,NPART)
          L0 = L0+NUMELS

          IF (NUMELQ>0) CALL TAGELEM_R2R(NUMELQ,IPART(L0),TAG_ELQ,NPART)
          L0 = L0+NUMELQ

          IF (NUMELC>0) CALL TAGELEM_R2R(NUMELC,IPART(L0),TAG_ELC,NPART)
          L0 = L0+NUMELC

          IF (NUMELT>0) CALL TAGELEM_R2R(NUMELT,IPART(L0),TAG_ELT,NPART)
          L0 = L0+NUMELT

          IF (NUMELP>0) CALL TAGELEM_R2R(NUMELP,IPART(L0),TAG_ELP,NPART)
          L0 = L0+NUMELP

          IF (NUMELR>0) CALL TAGELEM_R2R(NUMELR,IPART(L0),TAG_ELR,NPART)
          L0 = L0+NUMELR

          IF (NUMELTG>0)CALL TAGELEM_R2R(NUMELTG,IPART(L0),TAG_ELG,NPART)
          L0 = L0+NUMELTG+NUMELX

          IF (NUMSPH>0) CALL TAGELEM_R2R(NUMSPH,IPART(L0),TAG_ELSP,NPART)

C---------------Tag of injectors and corresponding material and property-----------C
          CALL R2R_MONVOL(TAG_MAT,TAG_PROP,IGRSURF,LSUBMODEL)

C----------------------------------------------------------------------------------C
C--------------------------First pass -> counting----------------------------------C
C----------------------------------------------------------------------------------C

          COMPT = 0
          NNODN = 0
          NODSUPR = 0
          NSPHN = 0
          NELCN = 0
          NELTGN = 0
          NELTN = 0
          NELRN = 0
          NELPN = 0
          NELQN = 0
          NELSN = 0
          NELS10N = 0
          NELS20N = 0
          NELS16N = 0
          NINLETN = 0
          SIZ_IPM_NEW = NPROPMI
          SIZ_PM_NEW = NPROPM
          SIZ_IGEO_NEW = NPROPGI
          SIZ_GEO_NEW = NPROPG

C ---------> counting of materials  -------------------------------------------C
          DO J=1,NUMMAT
            IF (TAG_MAT(J)/=0)THEN
              SIZ_IPM_NEW = SIZ_IPM_NEW + NPROPMI
              SIZ_PM_NEW = SIZ_PM_NEW + NPROPM
            ENDIF
          ENDDO
C ---------> counting of properties  -------------------------------------------C
          DO J=1,NUMGEO
            IF (TAG_PROP(J)/=0)THEN
              SIZ_IGEO_NEW = SIZ_IGEO_NEW + NPROPGI
              SIZ_GEO_NEW = SIZ_GEO_NEW + NPROPG
            ENDIF
          ENDDO
C ---------> counting of nodes and deleted nodes-----------------------------------C
          DO J=1,NUMNOD
            IF (TAGNO(J+NPART)>=0)THEN
              NNODN = NNODN+1
            ELSE
              NODSUPR = NODSUPR+1
            ENDIF
          ENDDO
C ---------> counting of parts  ---------------------------------------------------C
          DO J=1,NPART
            IF (TAG_PART(J)==1) THEN
              NPARN = NPARN+1
            ENDIF
          ENDDO
C ---------> DUmmy nodes  ---------------------------------------------------C
          NNODN = NNODN+1
C ---------> couting of shells  ---------------------------------------------------C
          DO J=1,NUMELC
            IF (TAG_ELC(J+NPART)/=0) THEN
              NELCN = NELCN+1
            ENDIF
          ENDDO
C ---------> counting of sh3n  ---------------------------------------------------C
          DO J=1,NUMELTG
            IF (TAG_ELG(J+NPART)/=0) THEN
              NELTGN = NELTGN+1
            ENDIF
          ENDDO
C ---------> counting of truss  ---------------------------------------------------C
          DO J=1,NUMELT
            IF (TAG_ELT(J+NPART)/=0) THEN
              NELTN = NELTN+1
            ENDIF
          ENDDO
C ---------> counting of springs---------------------------------------------------C
          DO J=1,NUMELR
            IF (TAG_ELR(J+NPART)/=0) THEN
              NELRN = NELRN+1
            ENDIF
          ENDDO
C ---------> comptage des beams----------------------------------------------------C
          DO J=1,NUMELP
            IF (TAG_ELP(J+NPART)/=0) THEN
              NELPN = NELPN+1
            ENDIF
          ENDDO
C ---------> counting of beams  ---------------------------------------------------C
          DO J=1,NUMELQ
            IF (TAG_ELQ(J+NPART)/=0) THEN
              NELQN = NELQN+1
            ENDIF
          ENDDO
C ---------> counting of solids  ---------------------------------------------------C
          DO J=1,NUMELS
            IF (TAG_ELS(J+NPART)/=0) THEN
              NELSN = NELSN+1
              IF (EANI2(J)==10) NELS10N = NELS10N+1
              IF (EANI2(J)==20) NELS20N = NELS20N+1
              IF (EANI2(J)==16) NELS16N = NELS16N+1
            ENDIF
          ENDDO
C ---------> counting of SPH particles---------------------------------------------C
          DO J=1,NUMSPH
            IF (TAG_ELSP(J+NPART)/=0) THEN
              NSPHN = NSPHN+1
            ENDIF
          ENDDO
C ---------> counting of particles reserve-----------------------------------------C
          FIRST_CELL = FIRST_SPHRES
          DO J=1,NBPARTINLET
            IF (TAG_ELSP(FIRST_CELL+NPART)/=0) THEN
              NINLETN = NINLETN + 1
            ENDIF
            FIRST_CELL = FIRST_CELL + RESERVEP(J)
          ENDDO

C----------------------------------------------------------------------------------C
        ENDIF ! IF (FLAG==0) THEN

C----------------------------------------------------------------------------------C
C-------------------------Second pass -> split of arrays --------------------------C
C----------------------------------------------------------------------------------C

        IF (FLAG==1) THEN

C----------------------------------------------------------------------------------C
C-------------Split of materials --------------------------------------------------C
C----------------------------------------------------------------------------------C

          ALLOCATE (IPM_TEMP(NPROPMI*NUMMAT),PM_TEMP(NPROPM*NUMMAT))
          ALLOCATE(CORESMA(NUMMAT))
          DO I=1,NUMMAT
            DO J=1,NPROPMI
              IPM_TEMP(NPROPMI*(I-1)+J)=IPM(NPROPMI*(I-1)+J)
            END DO
          END DO
          DO I=1,NUMMAT
            DO J=1,NPROPM
              PM_TEMP(NPROPM*(I-1)+J)=PM(NPROPM*(I-1)+J)
            END DO
          END DO
          DEALLOCATE(IPM,PM)

C-------------Split----------------------------------------------------------------C

          ALLOCATE(IPM(SIZ_IPM_NEW),PM(SIZ_PM_NEW))
          COMPT = 0
          DO J=1,NUMMAT
            IF ((TAG_MAT(J)/=0).OR.(J==NUMMAT)) THEN
              COMPT = COMPT+1
              CORESMA(J)=COMPT
              DO K=1,NPROPMI
                IPM(NPROPMI*(COMPT-1)+K)=IPM_TEMP(NPROPMI*(J-1)+K)
              END DO
              DO K=1,NPROPM
                PM(NPROPM*(COMPT-1)+K)=PM_TEMP(NPROPM*(J-1)+K)
              END DO
            ENDIF
          ENDDO

          NUMMAT = COMPT
          DEALLOCATE(IPM_TEMP,PM_TEMP)

C----------------------------------------------------------------------------------C
C-------------Split of properties -------------------------------------------------C
C----------------------------------------------------------------------------------C

          ALLOCATE (IGEO_TEMP(NPROPGI*NUMGEO),GEO_TEMP(NPROPG*NUMGEO))
          ALLOCATE(CORESPRO(NUMGEO))
          DO I=1,NUMGEO
            DO J=1,NPROPGI
              IGEO_TEMP(NPROPGI*(I-1)+J)=IGEO(NPROPGI*(I-1)+J)
            END DO
          END DO
          DO I=1,NUMGEO
            DO J=1,NPROPG
              GEO_TEMP(NPROPG*(I-1)+J)=GEO(NPROPG*(I-1)+J)
            END DO
          END DO
          DEALLOCATE(IGEO,GEO)

C-------------Split----------------------------------------------------------------C

          ALLOCATE(IGEO(SIZ_IGEO_NEW),GEO(SIZ_GEO_NEW))
          COMPT = 0
          MAXANUS = 0
          DO J=1,NUMGEO
            IF (TAG_PROP(J)/=0) THEN
              COMPT = COMPT+1
              CORESPRO(J)=COMPT
              DO K=1,NPROPGI
                MAXANUS = NPROPGI*(COMPT-1)+K
                IGEO(NPROPGI*(COMPT-1)+K)=IGEO_TEMP(NPROPGI*(J-1)+K)
              END DO
              DO K=1,NPROPG
                GEO(NPROPG*(COMPT-1)+K)=GEO_TEMP(NPROPG*(J-1)+K)
              END DO
            ENDIF
          ENDDO

          NUMGEO = COMPT
          DEALLOCATE(IGEO_TEMP,GEO_TEMP)

C----------------------------------------------------------------------------------C
C-------------Split of PARTS-------------------------------------------------------C
C----------------------------------------------------------------------------------C

          DO J=1,NPART
            IPART(LIPART1*(J-1)+1)=CORESMA(IPART(LIPART1*(J-1)+1))
            IPART(LIPART1*(J-1)+2)=CORESPRO(IPART(LIPART1*(J-1)+2))
          ENDDO

C----------------------------------------------------------------------------------C
C-------------Split of nodes-------------------------------------------------------C
C----------------------------------------------------------------------------------C

          ALLOCATE(CORESN(NUMNOD),X_TEMP(3,NUMNOD))
          ALLOCATE(ITAB_TEMP(NUMNOD))
          DO J=1,NUMNOD
            ITAB_TEMP(J)=ITAB(J)
            X_TEMP(1,J)=X(3*(J-1)+1)
            X_TEMP(2,J)=X(3*(J-1)+2)
            X_TEMP(3,J)=X(3*(J-1)+3)
          END DO
          DEALLOCATE(ITAB,X)

C-------------Split----------------------------------------------------------------C
          ALLOCATE(ITAB(NNODN),X(3*NNODN),ITAB_SUP(NODSUPR))
          ALLOCATE(FRONT_R2R(NNODN))
          ALLOCATE(FLAGKIN_R2R(NNODN))
          FLAGKIN_R2R(1:NNODN)=0
          FRONT_R2R(1:NNODN)=0
          COMPT = 0
          COMPTB = 0
          MAXN=0
          DO J=1,NUMNOD
            IF (TAGNO(J+NPART)>=0)THEN
              COMPT = COMPT+1
              ITAB(COMPT)=ITAB_TEMP(J)
              IF (ITAB(COMPT)>MAXN) MAXN = ITAB(COMPT)
              CORESN(J)=COMPT
              X(3*(COMPT-1)+1)=X_TEMP(1,J)
              X(3*(COMPT-1)+2)=X_TEMP(2,J)
              X(3*(COMPT-1)+3)=X_TEMP(3,J)
c     FRONT_R2R(COMPT)=FRONT(J,1)
              FRONT_R2R(COMPT) = NLOCAL(J,1)
              IF(FLAGKIN(J)==1)THEN
                FLAGKIN_R2R(COMPT)=1
              ENDIF
c     ELSE
c       FRONT_R2R(COMPT) = 0
c     ENDIF
              IF (TAGNO(J+NPART)>1) THEN
                MS(COMPT)=1e-20
                IF (IRODDL==1) IN(COMPT)=1e-20
              ENDIF
            ELSE
              COMPTB = COMPTB+1
              ITAB_SUP(COMPTB)=ITAB_TEMP(J)
            ENDIF
          ENDDO

C -----------update of skews-------------------------------------------------------C
          DO J=1,NUMSKW
            DO K=1,3
              IF (ISKWN(LISKN*J+K)>0)
     .              ISKWN(LISKN*J+K)=CORESN(ISKWN(LISKN*J+K))
            END DO
          ENDDO

C -----------update of frames------------------------------------------------------C
          JJ = SISKWN-SIFRAME
          IF (NSPHN==NUMSPH) THEN
            DO J=1,NUMFRAM
              DO K=1,3
                IF (ISKWN(JJ+LISKN*J+K)>0)
     .                ISKWN(JJ+LISKN*J+K)=CORESN(ISKWN(JJ+LISKN*J+K))
              END DO
            ENDDO
          ELSE
C--         advance of fraomes if SPH particles are removed
            JJB = SISKWN-SIFRAME-MIN(IUN,NSPCOND0)*(NUMSPH-NSPHN)*LISKN
            DO J=1,NUMFRAM
              DO K=1,3
                IF (ISKWN(JJ+LISKN*J+K)>0) THEN
                  ISKWN(JJB+LISKN*J+K)=CORESN(ISKWN(JJ+LISKN*J+K))
                ENDIF
              END DO
              DO K=4,LISKN
                ISKWN(JJB+LISKN*J+K)=ISKWN(JJ+LISKN*J+K)
              END DO
            END DO
          ENDIF

          NUMNOD_OLD = NUMNOD
          NUMNOD = COMPT
          NUMNOD0 = COMPT
          DEALLOCATE(ITAB_TEMP,X_TEMP)

C-------------Reconstitution of ITABM1---------------------------------------------C
          PART1  => ITABM1(1:2*NUMNOD)
          CALL CONSTIT(ITAB,PART1,NUMNOD)

C-------------A second list of removed nodes is generated for error detection
          IF (NODSUPR/=0) THEN
            PART2  => ITABM1(2*NUMNOD+1:2*NUMNOD_OLD)
            CALL CONSTIT(ITAB_SUP,PART2,NODSUPR)
            DEALLOCATE(ITAB_SUP)
          ENDIF

C----------------------------------------------------------------------------------C
C-------------Split of NALE_R2R----------------------------------------------------C
C----------------------------------------------------------------------------------C

          IF (ALE%GLOBAL%SNALE>0) THEN
C
            ALLOCATE(NALE_R2R_TEMP(ALE%GLOBAL%SNALE))
            DO J=1,NUMNOD_OLD
              NALE_R2R_TEMP(J)=NALE_R2R(J)
            END DO

C-------------Split----------------------------------------------------------------C
            NALE_R2R(:) = 0
            COMPT = 0
            DO J=1,NUMNOD_OLD
              IF (TAGNO(J+NPART)>=0) THEN
                COMPT = COMPT+1
                NALE_R2R(COMPT) =  NALE_R2R_TEMP(J)
              ENDIF
            END DO
            DEALLOCATE(NALE_R2R_TEMP)

          ENDIF

C----------------------------------------------------------------------------------C
C-------------Split of EANI--------------------------------------------------------C
C----------------------------------------------------------------------------------C

          NTOT = NELSN+NELCN+NELTGN+NELQN
          ALLOCATE(EANI_TEMP(SEANI))
          COMPT = 0

          DO J=1,SEANI
            EANI_TEMP(J)=EANI2(J)
            EANI2(J)=0
          END DO

          SEANI = NTOT

          DO J=1,NUMELS
            IF (TAG_ELS(J+NPART)/=0) THEN
              COMPT = COMPT + 1
              EANI2(COMPT)=EANI_TEMP(J)
            ENDIF
          END DO

          COMPT = NELSN+NELCN+NELQN
          DO J=1,NUMELTG
            IF (TAG_ELG(J+NPART)/=0) THEN
              COMPT = COMPT + 1
              EANI2(COMPT)=EANI_TEMP(NUMELS+NUMELQ+NUMELC+J)
            ENDIF
          END DO

C----------------------------------------------------------------------------------C
C-------------INITIALIZATION OF IPART----------------------------------------------C
C----------------------------------------------------------------------------------C

          SIPART0 = LIPART1*NPART+LIPART1*NTHPART
          SIPARTTH= 2*9*NPART+2*9*NTHPART
          ALLOCATE(IPART_TEMP(SIPART))

          DO J=1,SIPART
            IPART_TEMP(J)=IPART(J)
          END DO

          DEALLOCATE(IPART)
          SIPART  = SIPART0+SIPARTTH+NELSN+NELQN+NELCN+NELTN+NELPN
     .        + NELRN+NELTGN+NUMELX+NUMSPH
          ALLOCATE(IPART(SIPART))

          DO J=1,SIPART0+SIPARTTH
            IPART(J)=IPART_TEMP(J)
          END DO

          COMPT_IP = SIPART0+SIPARTTH
          COMPT_IP_TMP = SIPART0+SIPARTTH

C----------------------------------------------------------------------------------C
C-------------Split of SOLID elements----------------------------------------------C
C----------------------------------------------------------------------------------C

          ALLOCATE(IX_TEMP(SIXS),CORESS(NUMELS))

          DO J=1,NUMELS
            DO K=1,NIXS
              IX_TEMP(NIXS*(J-1)+K)=IXS(NIXS*(J-1)+K)
            END DO
          END DO

C-------------Storage of additional terms IXS10,IXS20,IXS16------------------------C

          DO J=NUMELS+1,SIXS
            IX_TEMP(J)=IXS(J)
          END DO

          DEALLOCATE(IXS)

C-------------Split----------------------------------------------------------------C

          SIXSN = NELSN*NIXS+NELS10N*6+NELS20N*12+NELS16N*8
          ALLOCATE(IXS(SIXSN),TAG_ELSF(NELSN))
          TAG_ELSF = 0
          COMPT = 0
          COMPT8 = 0
          COMPT10 = 0
          COMPT20 = 0
          COMPT16 = 0
          J10 = 0
          J20 = 0
          J16 = 0

          DO J=1,NUMELS
            COMPT_IP_TMP=COMPT_IP_TMP+1
            IF (EANI_TEMP(J)==10) J10 = J10+1
            IF (EANI_TEMP(J)==20) J20 = J20+1
            IF (EANI_TEMP(J)==16) J16 = J16+1
            IF (TAG_ELS(J+NPART)/=0) THEN
              COMPT_IP=COMPT_IP+1
              COMPT = COMPT+1
              CORESS(J)=COMPT
              IPART(COMPT_IP)=IPART_TEMP(COMPT_IP_TMP)
              DO K=1,NIXS
                IXS(NIXS*(COMPT-1)+K)=IX_TEMP(NIXS*(J-1)+K)
              END DO
              IXS(NIXS*(COMPT-1)+1)=CORESMA(IX_TEMP(NIXS*(J-1)+1))
              IXS(NIXS*(COMPT-1)+10)=CORESPRO(IX_TEMP(NIXS*(J-1)+10))
              DO K=2,9
                IXS(NIXS*(COMPT-1)+K)=CORESN(IX_TEMP(NIXS*(J-1)+K))
              END DO
              IF (TAG_ELSF2(J)>1) TAG_ELSF(COMPT) = 1
              IF (EANI_TEMP(J)==10) THEN
                COMPT10 = COMPT10+1
                DO K=1,6
                  IXS(NIXS*NELSN+6*(COMPT10-1)+K)=
     .                          CORESN(IX_TEMP(NIXS*NUMELS+6*(J10-1)+K))
                END DO
              ELSEIF (EANI_TEMP(J)==20) THEN
                COMPT20 = COMPT20+1
                DO K=1,12
                  IXS((NIXS*NELSN+6*NELS10N)+12*(COMPT20-1)+K)=
     .                             CORESN(IX_TEMP((NIXS*NUMELS+6*NUMELS10)+
     .                             12*(J20-1)+K))
                END DO
              ELSEIF (EANI_TEMP(J)==16) THEN
                COMPT16 = COMPT16+1
                DO K=1,8
                  IXS((NIXS*NELSN+6*NELS10N+12*NELS20N)+8*(COMPT16-1)+K)=
     .                             CORESN(IX_TEMP((NIXS*NUMELS+6*NUMELS10+
     .                             12*NUMELS20)+8*(J16-1)+K))
                END DO
              ELSE
                COMPT8 = COMPT8+1
              ENDIF

            ENDIF
          ENDDO

          NUMELS8 = COMPT8
          NUMELS10 = COMPT10
          NUMELS20 = COMPT20
          NUMELS16 = COMPT16
          NUMELS = COMPT

          DEALLOCATE(IX_TEMP)


C----------------------------------------------------------------------------------C
C-------------Split of QUAD elements-----------------------------------------------C
C----------------------------------------------------------------------------------C

          ALLOCATE(IX_TEMP(NUMELQ*NIXQ),CORESQ(NUMELQ))
          DO J=1,NUMELQ
            DO K=1,NIXQ
              IX_TEMP(NIXQ*(J-1)+K)=IXQ(NIXQ*(J-1)+K)
            END DO
          END DO
          DEALLOCATE(IXQ)

C-------------Split----------------------------------------------------------------C

          ALLOCATE(IXQ(NELQN*NIXQ))
          COMPT = 0
          DO J=1,NUMELQ
            COMPT_IP_TMP=COMPT_IP_TMP+1
            IF (TAG_ELQ(J+NPART)/=0) THEN
              COMPT_IP=COMPT_IP+1
              COMPT = COMPT+1
              CORESQ(J)=COMPT
              IPART(COMPT_IP)=IPART_TEMP(COMPT_IP_TMP)
              DO K=1,NIXQ
                IXQ(NIXQ*(COMPT-1)+K)=IX_TEMP(NIXQ*(J-1)+K)
              END DO
              IXQ(NIXQ*(COMPT-1)+1)=CORESMA(IX_TEMP(NIXQ*(J-1)+1))
              IXQ(NIXQ*(COMPT-1)+6)=CORESPRO(IX_TEMP(NIXQ*(J-1)+6))
              DO K=2,5
                IXQ(NIXQ*(COMPT-1)+K)=CORESN(IX_TEMP(NIXQ*(J-1)+K))
              END DO
            ENDIF
          ENDDO

          NUMELQ = COMPT
          DEALLOCATE(IX_TEMP)

C----------------------------------------------------------------------------------C
C-------------Split of SHELL elements----------------------------------------------C
C----------------------------------------------------------------------------------C

          NUMELC0 = NUMELC
          ALLOCATE(IX_TEMP(NUMELC*NIXC),CORESC(NUMELC))
          CALL MY_ALLOC (IWORKSH_TEMP,3,NUMELC)
          DO J=1,NUMELC
            DO K=1,NIXC
              IX_TEMP(NIXC*(J-1)+K)=IXC(NIXC*(J-1)+K)
            END DO
            IWORKSH_TEMP(1,J) = IWORKSH(1,J)
            IWORKSH_TEMP(2,J) = IWORKSH(2,J)
            IWORKSH_TEMP(3,J) = IWORKSH(3,J)
          END DO
          DEALLOCATE(IXC)

C-------------Split----------------------------------------------------------------C
          ALLOCATE(IXC(NELCN*NIXC),TAG_ELCF(NELCN))
          TAG_ELCF = 0
          COMPT = 0
          DO J=1,NUMELC
            COMPT_IP_TMP=COMPT_IP_TMP+1
            IF (TAG_ELC(J+NPART)/=0) THEN
              COMPT_IP=COMPT_IP+1
              COMPT = COMPT+1
              CORESC(J)=COMPT
              IPART(COMPT_IP)=IPART_TEMP(COMPT_IP_TMP)
              DO K=1,NIXC
                IXC(NIXC*(COMPT-1)+K)=IX_TEMP(NIXC*(J-1)+K)
              END DO
              IXC(NIXC*(COMPT-1)+1)=CORESMA(IX_TEMP(NIXC*(J-1)+1))
              IXC(NIXC*(COMPT-1)+6)=CORESPRO(IX_TEMP(NIXC*(J-1)+6))
              DO K=2,5
                IXC(NIXC*(COMPT-1)+K)=CORESN(IX_TEMP(NIXC*(J-1)+K))
              END DO
              IF (TAG_ELCF2(J) > 1) TAG_ELCF(COMPT) = 1
              IF (TAG_PART(IPART(COMPT_IP)) /= 0) THEN
                IWORKSH(1,COMPT)=IWORKSH_TEMP(1,J)
                IWORKSH(2,COMPT)=IWORKSH_TEMP(2,J)
                IWORKSH(3,COMPT)=IWORKSH_TEMP(3,J)
              ELSE
                IWORKSH(1,COMPT)=ZERO
                IWORKSH(2,COMPT)=ZERO
                IWORKSH(3,COMPT)=ZERO
              ENDIF
            ENDIF
          ENDDO

          NUMELC = COMPT
          DEALLOCATE(IX_TEMP,IWORKSH_TEMP)

C----------------------------------------------------------------------------------C
C-------------Split of TRUSS elements----------------------------------------------C
C----------------------------------------------------------------------------------C

          ALLOCATE(IX_TEMP(NUMELT*NIXT),COREST(NUMELT))
          DO J=1,NUMELT
            DO K=1,NIXT
              IX_TEMP(NIXT*(J-1)+K)=IXT(NIXT*(J-1)+K)
            END DO
          END DO
          DEALLOCATE(IXT)

C-------------Split----------------------------------------------------------------C

          ALLOCATE(IXT(NELTN*NIXT))
          COMPT = 0
          DO J=1,NUMELT
            COMPT_IP_TMP=COMPT_IP_TMP+1
            IF (TAG_ELT(J+NPART)/=0) THEN
              COMPT_IP=COMPT_IP+1
              COMPT = COMPT+1
              COREST(J)=COMPT
              IPART(COMPT_IP)=IPART_TEMP(COMPT_IP_TMP)
              DO K=1,NIXT
                IXT(NIXT*(COMPT-1)+K)=IX_TEMP(NIXT*(J-1)+K)
              END DO
              IXT(NIXT*(COMPT-1)+1)=CORESMA(IX_TEMP(NIXT*(J-1)+1))
              IXT(NIXT*(COMPT-1)+4)=CORESPRO(IX_TEMP(NIXT*(J-1)+4))
              DO K=2,3
                IXT(NIXT*(COMPT-1)+K)=CORESN(IX_TEMP(NIXT*(J-1)+K))
              END DO
            ENDIF
          ENDDO

          NUMELT = COMPT
          DEALLOCATE(IX_TEMP)


C----------------------------------------------------------------------------------C
C-------------Split of BEAM elements-----------------------------------------------C
C----------------------------------------------------------------------------------C

          ALLOCATE(IX_TEMP(NUMELP*NIXP),CORESP(NUMELP))
          DO J=1,NUMELP
            DO K=1,NIXP
              IX_TEMP(NIXP*(J-1)+K)=IXP(NIXP*(J-1)+K)
            END DO
          END DO
          DEALLOCATE(IXP)

C-------------Split----------------------------------------------------------------C

          ALLOCATE(IXP(NELPN*NIXP))
          COMPT = 0
          DO J=1,NUMELP
            COMPT_IP_TMP=COMPT_IP_TMP+1
            IF (TAG_ELP(J+NPART)/=0) THEN
              COMPT_IP=COMPT_IP+1
              COMPT = COMPT+1
              CORESP(J)=COMPT
              IPART(COMPT_IP)=IPART_TEMP(COMPT_IP_TMP)
              DO K=1,NIXP
                IXP(NIXP*(COMPT-1)+K)=IX_TEMP(NIXP*(J-1)+K)
              END DO
              IXP(NIXP*(COMPT-1)+1)=CORESMA(IX_TEMP(NIXP*(J-1)+1))
              IXP(NIXP*(COMPT-1)+5)=CORESPRO(IX_TEMP(NIXP*(J-1)+5))
              DO K=2,4
                IXP(NIXP*(COMPT-1)+K)=CORESN(IX_TEMP(NIXP*(J-1)+K))
              END DO
            ENDIF
          ENDDO

          NUMELP = COMPT
          DEALLOCATE(IX_TEMP)


C----------------------------------------------------------------------------------C
C-------------Split of SPRINGS and KJOINTS-----------------------------------------C
C----------------------------------------------------------------------------------C

          ALLOCATE(IX_TEMP(NUMELR*5+1))
          DO J=1,NUMELR
            DO K=1,5
              IX_TEMP(5*(J-1)+K)=IXR_KJ(5*(J-1)+K)
              IXR_KJ(5*(J-1)+K) = 0
            END DO
          END DO

C-------------Split----------------------------------------------------------------C

          COMPT = 0
          COMPTB = 0
          DO J=1,NUMELR
            ID_PROP = CORESPRO(IXR(NIXR*(J-1)+1))
            IF (IGEO(NPROPGI*(ID_PROP-1)+11)==45) THEN
              COMPTB = COMPTB + 1
              IF (TAG_ELR(J+NPART)/=0) THEN
                COMPT = COMPT + 1
                DO K=1,3
                  IXR_KJ(5*(COMPT-1)+K)=CORESN(IX_TEMP(5*(COMPTB-1)+K))
                END DO
                IXR_KJ(5*(COMPT-1)+4)=IX_TEMP(5*(COMPTB-1)+4)
                IXR_KJ(5*(COMPT-1)+5)=0
              ENDIF
            ENDIF
          ENDDO

          IXR_KJ(5*NELRN+1) = COMPT
          DEALLOCATE(IX_TEMP)

C----------------------------------------------------------------------------------C
C-------------Split of SPRING elements---------------------------------------------C
C----------------------------------------------------------------------------------C

          ALLOCATE(IX_TEMP(NUMELR*NIXR),CORESR(NUMELR))
          DO J=1,NUMELR
            DO K=1,NIXR
              IX_TEMP(NIXR*(J-1)+K)=IXR(NIXR*(J-1)+K)
            END DO
          END DO
          DEALLOCATE(IXR)

C-------------Split----------------------------------------------------------------C

          ALLOCATE(IXR(NELRN*NIXR))
          COMPT = 0
          DO J=1,NUMELR
            COMPT_IP_TMP=COMPT_IP_TMP+1
            IF (TAG_ELR(J+NPART)/=0) THEN
              COMPT_IP=COMPT_IP+1
              COMPT = COMPT+1
              CORESR(J)=COMPT
              IPART(COMPT_IP)=IPART_TEMP(COMPT_IP_TMP)
              DO K=1,NIXR
                IXR(NIXR*(COMPT-1)+K)=IX_TEMP(NIXR*(J-1)+K)
              END DO
              IXR(NIXR*(COMPT-1)+1)=CORESPRO(IX_TEMP(NIXR*(J-1)+1))
              DO K=2,3
                IXR(NIXR*(COMPT-1)+K)=CORESN(IX_TEMP(NIXR*(J-1)+K))
              END DO
              IF (IXR(NIXR*(COMPT-1)+4)/=0) THEN
                IXR(NIXR*(COMPT-1)+4)=CORESN(IX_TEMP(NIXR*(J-1)+4))
              ENDIF
            ENDIF
          ENDDO

          NUMELR = COMPT
          DEALLOCATE(IX_TEMP)

C----------------------------------------------------------------------------------C
C-------------Split of SH3N elements-----------------------------------------------C
C----------------------------------------------------------------------------------C

          NUMELTG0 = NUMELTG
          ALLOCATE(IX_TEMP(NUMELTG*NIXTG),CORESTG(NUMELTG))
          DO J=1,NUMELTG
            DO K=1,NIXTG
              IX_TEMP(NIXTG*(J-1)+K)=IXTG(NIXTG*(J-1)+K)
            END DO
          END DO
          DEALLOCATE(IXTG)

C-------------Split----------------------------------------------------------------C

          ALLOCATE(IXTG(NELTGN*NIXTG))
          COMPT = 0
          DO J=1,NUMELTG
            COMPT_IP_TMP=COMPT_IP_TMP+1
            IF (TAG_ELG(J+NPART)/=0) THEN
              COMPT_IP=COMPT_IP+1
              COMPT = COMPT+1
              CORESTG(J)=COMPT
              IPART(COMPT_IP)=IPART_TEMP(COMPT_IP_TMP)
              DO K=1,NIXTG
                IXTG(NIXTG*(COMPT-1)+K)=IX_TEMP(NIXTG*(J-1)+K)
              END DO
              IXTG(NIXTG*(COMPT-1)+1)=CORESMA(IX_TEMP(NIXTG*(J-1)+1))
              IXTG(NIXTG*(COMPT-1)+5)=CORESPRO(IX_TEMP(NIXTG*(J-1)+5))
              DO K=2,4
                IXTG(NIXTG*(COMPT-1)+K)=CORESN(IX_TEMP(NIXTG*(J-1)+K))
              END DO
            ENDIF
          ENDDO

          NUMELTG = COMPT
          DEALLOCATE(IX_TEMP)

C----------------------------------------------------------------------------------C
C-------------Split of /SPH/RESERVE------------------------------------------------C
C----------------------------------------------------------------------------------C

          ALLOCATE(RES_TEMP(NBPARTINLET))
          DO J=1,NBPARTINLET
            RES_TEMP(J) = RESERVEP(J)
          END DO

C-------------Split----------------------------------------------------------------C
          COMPT = 0
          PART_RES = 0
          FIRST_CELL = FIRST_SPHRES
          DO J=1,NBPARTINLET
            IF (TAG_ELSP(FIRST_CELL+NPART)/=0) THEN
              COMPT = COMPT + 1
              RESERVEP(COMPT) = RES_TEMP(J)
            ENDIF
            DO K=1,RES_TEMP(J)
              INOD = KXSP(NISP*(FIRST_CELL-1)+3)
              FIRST_CELL = FIRST_CELL+1
            ENDDO
          ENDDO

          NBPARTINLET = COMPT
          DEALLOCATE(RES_TEMP)

C----------------------------------------------------------------------------------C
C-------------Split of SPH particles-----------------------------------------------C
C----------------------------------------------------------------------------------C

          COEFF = 0
          IF (NSPHN>0) COEFF = 1
          NUMSPHA = NUMSPH - NSPHRES
C
          ALLOCATE(KXSP_TEMP(NISP*NUMSPH),CORESSP(NUMSPH))
          DO J=1,NUMSPH
            DO K=1,NISP
              KXSP_TEMP(NISP*(J-1)+K)=KXSP(NISP*(J-1)+K)
            END DO
          END DO
          DEALLOCATE(IXSP,KXSP,NOD2SP,SPBUF)

C-------------Split----------------------------------------------------------------C
          ALLOCATE(IXSP(KVOISPH,NSPHN),KXSP(NISP*NSPHN),NOD2SP(COEFF*NUMNOD))
          ALLOCATE(SPBUF(NSPBUF*NSPHN))
          COMPT = 0
          NSPHRESN = 0
          DO J=1,NUMSPH
            COMPT_IP_TMP=COMPT_IP_TMP+1
            IF (TAG_ELSP(J+NPART)/=0) THEN
              COMPT_IP=COMPT_IP+1
              COMPT = COMPT+1
              CORESSP(J)=COMPT
              IF (J>=FIRST_SPHRES) NSPHRESN=NSPHRESN+1
              IPART(COMPT_IP)=IPART_TEMP(COMPT_IP_TMP)
              DO K=1,NISP
                KXSP(NISP*(COMPT-1)+K)=KXSP_TEMP(NISP*(J-1)+K)
              END DO
              KXSP(NISP*(COMPT-1)+3)=CORESN(KXSP_TEMP(NISP*(J-1)+3))
              NOD2SP(CORESN(KXSP_TEMP(NISP*(J-1)+3))) = COMPT
            ENDIF
          ENDDO
          IF ((COMPT/=0).AND.(COMPT/=NUMSPH)) THEN
            CALL ANCMSG(MSGID=1061,
     .                    MSGTYPE=MSGWARNING,
     .                    ANMODE=ANINFO_BLIND_1)
          ENDIF
          NUMSPH = COMPT
          NUMSPHA = COMPT - NSPHRESN
          NSPHRES =  NSPHRESN
          FIRST_SPHRES = NUMSPHA + 1
          DEALLOCATE(KXSP_TEMP)

C----------------------------------------------------------------------------------C

          DEALLOCATE(IPART_TEMP)

C----------------------------------------------------------------------------------C
C-------------Split of THKE for shell and sh3n elements----------------------------C
C----------------------------------------------------------------------------------C

          ALLOCATE(THK_TMP(NUMELTG0+NUMELC0))
          DO J=1,NUMELTG0+NUMELC0
            THK_TMP(J)=THKE(J)
          END DO
          DEALLOCATE(THKE)

C-------------Split----------------------------------------------------------------C

          ALLOCATE(THKE(NUMELTG+NUMELC))
          DO J=1,NUMELC0
            IF (TAG_ELC(J+NPART)/=0) THEN
              THKE(CORESC(J))=THK_TMP(J)
            ENDIF
          ENDDO
          DO J=1,NUMELTG0
            IF (TAG_ELG(J+NPART)/=0) THEN
              THKE(CORESTG(J)+NUMELC)=THK_TMP(J+NUMELC0)
            ENDIF
          ENDDO

          DEALLOCATE(THK_TMP)

C----------------------------------------------------------------------------------C
C-------------Split of GROUPS------------------------------------------------------C
C----------------------------------------------------------------------------------C

!!          ALLOCATE(BUF_TEMP(SIZE))
!!          DO I=1,SIZE
!!            BUF_TEMP(I)=BUF_NOD(I)
!!          END DO

C ---------> groups of elements----------------------------------------------------C
C             --> solids <--
          DO I=1,NGRBRIC
            COMPT = 0
            IGRBRIC(I)%R2R_SHARE = 0
            DO J=1,IGRBRIC(I)%NENTITY
              CUR_ID = IGRBRIC(I)%ENTITY(J)
              IF (TAG_ELS(CUR_ID+NPART)/=0)THEN
                COMPT = COMPT+1
                IGRBRIC(I)%ENTITY(COMPT) = CORESS(CUR_ID)
                IF (TAG_ELS(CUR_ID+NPART)>1)
     .               IGRBRIC(I)%R2R_SHARE = IGRBRIC(I)%R2R_SHARE + 1
              ENDIF
            ENDDO
            IGRBRIC(I)%R2R_ALL = IGRBRIC(I)%NENTITY
            IGRBRIC(I)%NENTITY = COMPT
          ENDDO
C             --> quads <--
          DO I=1,NGRQUAD
            COMPT = 0
            IGRQUAD(I)%R2R_SHARE = 0
            DO J=1,IGRQUAD(I)%NENTITY
              CUR_ID = IGRQUAD(I)%ENTITY(J)
              IF (TAG_ELQ(CUR_ID+NPART)/=0)THEN
                COMPT = COMPT+1
                IGRQUAD(I)%ENTITY(COMPT) = CORESQ(CUR_ID)
                IF (TAG_ELQ(CUR_ID+NPART)>1)
     .               IGRQUAD(I)%R2R_SHARE = IGRQUAD(I)%R2R_SHARE + 1
              ENDIF
            ENDDO
            IGRQUAD(I)%R2R_ALL = IGRQUAD(I)%NENTITY
            IGRQUAD(I)%NENTITY = COMPT
          ENDDO
C             --> sh4n <--
          DO I=1,NGRSHEL
            COMPT = 0
            IGRSH4N(I)%R2R_SHARE = 0
            DO J=1,IGRSH4N(I)%NENTITY
              CUR_ID = IGRSH4N(I)%ENTITY(J)
              IF (TAG_ELC(CUR_ID+NPART)/=0)THEN
                COMPT = COMPT+1
                IGRSH4N(I)%ENTITY(COMPT) = CORESC(CUR_ID)
                IF (TAG_ELC(CUR_ID+NPART)>1)
     .               IGRSH4N(I)%R2R_SHARE = IGRSH4N(I)%R2R_SHARE + 1
              ENDIF
            ENDDO
            IGRSH4N(I)%R2R_ALL = IGRSH4N(I)%NENTITY
            IGRSH4N(I)%NENTITY = COMPT
          ENDDO
C             --> truss <--
          DO I=1,NGRTRUS
            COMPT = 0
            IGRTRUSS(I)%R2R_SHARE = 0
            DO J=1,IGRTRUSS(I)%NENTITY
              CUR_ID = IGRTRUSS(I)%ENTITY(J)
              IF (TAG_ELT(CUR_ID+NPART)/=0)THEN
                COMPT = COMPT+1
                IGRTRUSS(I)%ENTITY(COMPT) = COREST(CUR_ID)
                IF (TAG_ELT(CUR_ID+NPART)>1)
     .               IGRTRUSS(I)%R2R_SHARE = IGRTRUSS(I)%R2R_SHARE + 1
              ENDIF
            ENDDO
            IGRTRUSS(I)%R2R_ALL = IGRTRUSS(I)%NENTITY
            IGRTRUSS(I)%NENTITY = COMPT
          ENDDO
C             --> beams <--
          DO I=1,NGRBEAM
            COMPT = 0
            IGRBEAM(I)%R2R_SHARE = 0
            DO J=1,IGRBEAM(I)%NENTITY
              CUR_ID = IGRBEAM(I)%ENTITY(J)
              IF (TAG_ELP(CUR_ID+NPART)/=0)THEN
                COMPT = COMPT+1
                IGRBEAM(I)%ENTITY(COMPT) = CORESP(CUR_ID)
                IF (TAG_ELP(CUR_ID+NPART)>1)
     .               IGRBEAM(I)%R2R_SHARE = IGRBEAM(I)%R2R_SHARE + 1
              ENDIF
            ENDDO
            IGRBEAM(I)%R2R_ALL = IGRBEAM(I)%NENTITY
            IGRBEAM(I)%NENTITY = COMPT
          ENDDO
C             --> springs <--
          DO I=1,NGRSPRI
            COMPT = 0
            IGRSPRING(I)%R2R_SHARE = 0
            DO J=1,IGRSPRING(I)%NENTITY
              CUR_ID = IGRSPRING(I)%ENTITY(J)
              IF (TAG_ELR(CUR_ID+NPART)/=0)THEN
                COMPT = COMPT+1
                IGRSPRING(I)%ENTITY(COMPT) = CORESR(CUR_ID)
                IF (TAG_ELR(CUR_ID+NPART)>1)
     .               IGRSPRING(I)%R2R_SHARE = IGRSPRING(I)%R2R_SHARE + 1
              ENDIF
            ENDDO
            IGRSPRING(I)%R2R_ALL = IGRSPRING(I)%NENTITY
            IGRSPRING(I)%NENTITY = COMPT
          ENDDO
C             --> sh3n <--
          DO I=1,NGRSH3N
            COMPT = 0
            IGRSH3N(I)%R2R_SHARE = 0
            DO J=1,IGRSH3N(I)%NENTITY
              CUR_ID = IGRSH3N(I)%ENTITY(J)
              IF (TAG_ELG(CUR_ID+NPART)/=0)THEN
                COMPT = COMPT+1
                IGRSH3N(I)%ENTITY(COMPT) = CORESTG(CUR_ID)
                IF (TAG_ELG(CUR_ID+NPART)>1)
     .               IGRSH3N(I)%R2R_SHARE = IGRSH3N(I)%R2R_SHARE + 1
              ENDIF
            ENDDO
            IGRSH3N(I)%R2R_ALL = IGRSH3N(I)%NENTITY
            IGRSH3N(I)%NENTITY = COMPT
          ENDDO

C ---------> groups of parts-----------------------------------------------------C

          DO I=1,NGRPART
            COMPT = 0
            DO J=1,IGRPART(I)%NENTITY
              CUR_ID = IGRPART(I)%ENTITY(J)
              IF (TAG_PART(CUR_ID)==1)THEN
                COMPT = COMPT+1
                IGRPART(I)%ENTITY(COMPT) = CUR_ID
              ENDIF
            ENDDO
            IGRPART(I)%R2R_ALL = IGRPART(I)%NENTITY
            IGRPART(I)%NENTITY = COMPT
          ENDDO
C----------------------------------------------------------------------------------C
C-------------Split of surfaces----------------------------------------------------C
C----------------------------------------------------------------------------------C

          DO I=1,NB_SURF
            NSEG = 0
            CCPL = 0
            DO J=1,IGRSURF(I)%NSEG
              NB_NOD_SUB=0
              NB_NOD_CPL=0
              TAG = 0
              CUR_ID = IGRSURF(I)%ELEM(J)
              IF (IGRSURF(I)%ELTYP(J) == 1) THEN
C---------------> case face of solid <--
                IF (TAG_ELS(CUR_ID+NPART)/=0) THEN
                  NEW_ID = CORESS(CUR_ID)
                  TAG = 1
                ENDIF
              ELSEIF (IGRSURF(I)%ELTYP(J) == 2) THEN
C---------------> case quad <--
                IF (TAG_ELQ(CUR_ID+NPART)/=0) THEN
                  NEW_ID = CORESQ(CUR_ID)
                  TAG = 1
                ENDIF
              ELSEIF (IGRSURF(I)%ELTYP(J) == 3) THEN
C---------------> case shell <--
                IF (TAG_ELC(CUR_ID+NPART)/=0) THEN
                  NEW_ID = CORESC(CUR_ID)
                  TAG = 1
                ENDIF
              ELSEIF (IGRSURF(I)%ELTYP(J) == 7) THEN
C---------------> case sh3n <--
                IF (TAG_ELG(CUR_ID+NPART)/=0) THEN
                  NEW_ID = CORESTG(CUR_ID)
                  TAG = 1
                ENDIF
              ELSEIF (IGRSURF(I)%ELTYP(J) > 10) THEN
C---------------> case of surface defined by segments and associated elements <--
                IF (IGRSURF(I)%ELTYP(J) == 11) THEN
                  IF (TAG_ELS(CUR_ID+NPART)/=0) TAG=1
                ELSEIF (IGRSURF(I)%ELTYP(J) == 13) THEN
                  IF (TAG_ELC(CUR_ID+NPART)/=0) TAG=1
                ELSEIF (IGRSURF(I)%ELTYP(J) == 17) THEN
                  IF (TAG_ELG(CUR_ID+NPART)/=0) TAG=1
                ENDIF
C                  ---> resef of type of segment <--
                IGRSURF(I)%ELTYP(J) = 0
                NEW_ID = 0
              ELSEIF (IGRSURF(I)%ELTYP(J) == 0) THEN
C---------------> case of surface defined by segments with nodes <--
                DO K=1,4
                  NOD_ID = IGRSURF(I)%NODES(J,K)
                  IF (TAGNO(NOD_ID+NPART)/=-1) NB_NOD_CPL=NB_NOD_CPL+1
                END DO
                IF (NB_NOD_CPL==4) THEN
                  TAG = 1
                  NEW_ID = 0
                ENDIF
              ENDIF
C---------------> TAG = 1, segment is kept, update of nodes <--
              IF (TAG == 1) THEN
                NSEG = NSEG + 1
                DO K=1,4
                  CUR_ID = IGRSURF(I)%NODES(J,K)
                  IF (TAGNO(CUR_ID+NPART)>1) NB_NOD_CPL=NB_NOD_CPL+1
                  IGRSURF(I)%NODES(NSEG,K) = CORESN(CUR_ID)
                END DO
                IF (NB_NOD_CPL==4) CCPL=CCPL+1
                IGRSURF(I)%ELTYP(NSEG) = IGRSURF(I)%ELTYP(J)
                IGRSURF(I)%ELEM(NSEG) = NEW_ID
              ENDIF
            END DO
            ISURF_R2R(2,I)  = IGRSURF(I)%NSEG
            IGRSURF(I)%NSEG = NSEG
            ISURF_R2R(1,I)  = CCPL
          END DO

C----------------------------------------------------------------------------------C
C-------------Split of Lines-------------------------------------------------------C
C----------------------------------------------------------------------------------C
          DO I=1,NB_LINE
            NSEG = 0
            DO J=1,IGRSLIN(I)%NSEG
              NB_NOD_SUB=0
              TAG = 0
              CUR_ID = IGRSLIN(I)%ELEM(J)
              IF (IGRSLIN(I)%ELTYP(J)==1) THEN
C---------------> case face of solid <--
                IF (TAG_ELS(CUR_ID+NPART)/=0) THEN
                  NEW_ID = CORESS(CUR_ID)
                  TAG = 1
                ENDIF
              ELSEIF (IGRSLIN(I)%ELTYP(J)==2) THEN
C---------------> case quad <--
                IF (TAG_ELQ(CUR_ID+NPART)/=0) THEN
                  NEW_ID = CORESQ(CUR_ID)
                  TAG = 2
                ENDIF
              ELSEIF (IGRSLIN(I)%ELTYP(J)==3) THEN
C---------------> case shell <--
                IF (TAG_ELC(CUR_ID+NPART)/=0) THEN
                  NEW_ID = CORESC(CUR_ID)
                  TAG = 3
                ENDIF
              ELSEIF (IGRSLIN(I)%ELTYP(J)==4) THEN
C---------------> case truss <--
                IF (TAG_ELT(CUR_ID+NPART)/=0) THEN
                  NEW_ID = COREST(CUR_ID)
                  TAG = 4
                ENDIF
              ELSEIF (IGRSLIN(I)%ELTYP(J)==5) THEN
C---------------> case beam <--
                IF (TAG_ELP(CUR_ID+NPART)/=0) THEN
                  NEW_ID = CORESP(CUR_ID)
                  TAG = 5
                ENDIF
              ELSEIF (IGRSLIN(I)%ELTYP(J)==6) THEN
C---------------> cas spring <--
                IF (TAG_ELR(CUR_ID+NPART)/=0) THEN
                  NEW_ID = CORESR(CUR_ID)
                  TAG = 6
                ENDIF
              ELSEIF (IGRSLIN(I)%ELTYP(J)==7) THEN
C---------------> cas sh3n <--
                IF (TAG_ELG(CUR_ID+NPART)/=0) THEN
                  NEW_ID = CORESTG(CUR_ID)
                  TAG = 7
                ENDIF
              ELSEIF (IGRSLIN(I)%ELTYP(J)==0) THEN
C---------------> No element, count of taged nodes <--
                NEW_ID = 0
                DO K=1,2
                  CUR_ID = IGRSLIN(I)%NODES(J,K)
                  IF (TAGNO(CUR_ID+NPART)>=0) NB_NOD_SUB=NB_NOD_SUB+1
                END DO
                IF (NB_NOD_SUB==2) TAG = 8
              ENDIF
C---------------> TAG = 1, segment is kept, update of nodes <--
              IF (TAG > 0) THEN
                NSEG = NSEG + 1
                DO K=1,2
                  CUR_ID = IGRSLIN(I)%NODES(J,K)
                  IGRSLIN(I)%NODES(NSEG,K) = CORESN(CUR_ID)
                END DO
                IGRSLIN(I)%ELTYP(NSEG) = IGRSLIN(I)%ELTYP(J)
                IGRSLIN(I)%ELEM(NSEG)  = NEW_ID
              ENDIF
            END DO
            IGRSLIN(I)%NSEG_R2R_ALL = IGRSLIN(I)%NSEG
            IGRSLIN(I)%NSEG = NSEG
          END DO

C----------------------------------------------------------------------------------C
C-------------Split of groups of nodes---------------------------------------------C
C----------------------------------------------------------------------------------C

          DO I=1,NGRNOD
! ---------> groups of nodes
            COMPT = 0
            CCPL = 0
            DO J=1,IGRNOD(I)%NENTITY
              CUR_ID = IGRNOD(I)%ENTITY(J)
              IF (TAGNO(CUR_ID+NPART) >= 0) THEN
                COMPT = COMPT + 1
                IGRNOD(I)%ENTITY(COMPT) = CORESN(CUR_ID)
              ENDIF
              IF (TAGNO(CUR_ID+NPART)>1) CCPL=CCPL+1
            ENDDO
            IGRNOD(I)%R2R_ALL   = IGRNOD(I)%NENTITY
            IGRNOD(I)%R2R_SHARE = CCPL
            IGRNOD(I)%NENTITY   = COMPT
          ENDDO ! DO I=1,NGRNOD

C----------------------------------------------------------------------------------C
C--------------Update of TAGNO-----------------------------------------------------C
C----------------------------------------------------------------------------------C

          ALLOCATE(TAGNO_TEMP(2*NUMNOD_OLD+NPART))
          DO J=1,NPART+2*NUMNOD_OLD
            TAGNO_TEMP(J)=TAGNO(J)
          END DO

          DEALLOCATE(TAGNO)
          ALLOCATE(TAGNO(2*NUMNOD+NPART))
          DO J=1,NPART
            TAGNO(J)=TAGNO_TEMP(J)
          END DO
          COMPT=0
          DO J=1,NUMNOD_OLD
            IF (TAGNO_TEMP(J+NPART)>=0)THEN
              COMPT=COMPT+1
              TAGNO(COMPT+NPART)=TAGNO_TEMP(J+NPART)
              TAGNO(COMPT+NPART+NUMNOD)=TAGNO_TEMP(J+NPART+NUMNOD_OLD)
            ENDIF
          ENDDO

C----------------------------------------------------------------------------------C
C------Prereading and tag of SECTIONS----------------------------------------------C
C----------------------------------------------------------------------------------C

          CALL PRELECSEC(
     1    NUL,NUL,ITABM1,2,NOM_OPT(LNOPT1*INOM_OPT(8)+1),
     2    IGRBRIC ,IGRQUAD   ,IGRSH4N ,IGRSH3N  ,IGRTRUSS,
     3    IGRBEAM ,IGRSPRING ,IGRNOD, LSUBMODEL ,SEATBELT_SHELL_TO_SPRING,
     4    NB_SEATBELT_SHELLS)

C----------------------------------------------------------------------------------C
C------Split of GAUGES-------------------------------------------------------------C
C----------------------------------------------------------------------------------C

          COMPT = 0
          DO I=1,NBGAUGE
            IF ((TAGGAU(I)>0).AND.(NUMELS>0)) THEN
C---------------> Cas des GAUGES <--
              COMPT = COMPT + 1
            ELSEIF ((TAGGAU(I)<0).AND.(NUMSPH>0)) THEN
C---------------> Cas des GAUGE/SPH <--
              TAGGAU(I) = ABS(TAGGAU(I))
              COMPT = COMPT + 1
            ELSE
              TAGGAU(I) = 0
            ENDIF
          ENDDO

          NBGAUGE = COMPT

C----------------------------------------------------------------------------------C
C------Split of RBY_MSN (used for /INIVEL/AXIS) -----------------------------------C
C----------------------------------------------------------------------------------C

          NRBODY_OLD = SIZE(TAGRBY)
          ALLOCATE(RBY_MSN_TEMP(2,NRBODY_OLD))
          DO I=1,NRBODY_OLD
            RBY_MSN_TEMP(1,I) = RBY_MSN(1,I)
            RBY_MSN_TEMP(2,I) = RBY_MSN(2,I)
            RBY_MSN(1,I) = 0
            RBY_MSN(2,I) = 0
          ENDDO

C-------------Split----------------------------------------------------------------C

          NRB =0
          DO I=1,NRBODY_OLD
            IF(TAGRBY(I) > 0) THEN
              NRB = NRB + 1
              RBY_MSN(1,NRB) = RBY_MSN_TEMP(1,I)
              RBY_MSN(2,NRB) = CORESN(RBY_MSN_TEMP(2,I))
            END IF
          ENDDO

C------------------------------------------------------------------------------------C

          FLG_SPLIT = 1
!!         DEALLOCATE(BUF_TEMP)
          DEALLOCATE(CORESC,CORESN,CORESTG,COREST)
          DEALLOCATE(CORESPRO,CORESR,CORESP,CORESS)
          DEALLOCATE(CORESQ,EANI_TEMP,TAGNO_TEMP)

C------------------------------------------------------------------------------------C

          DEALLOCATE(TAG_ELC,TAG_ELS,TAG_ELP,TAG_ELQ,TAG_ELR,TAG_ELT)
          DEALLOCATE(TAG_ELG,TAG_SURF,TAG_PROP,TAG_ELCF2,TAG_ELSF2)

C----------------------------------------------------------------------------------C
C------Rewritinf of TAGMAT and TAGPROP for grouping--------------------------------C
C----------------------------------------------------------------------------------C
          DO K=1,NPART
            IF(TAG_PART(K) == 0) THEN
              TAG_MAT(IPART(LIPART1*(K-1)+1))=0
            ENDIF
          END DO

C------------------------------------------------------------------------------------

        ENDIF
        RETURN

      END SUBROUTINE R2R_SPLIT
